home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Pascal Super Library
/
Pascal Super Library (CW International)(1997).bin
/
LIBRARY
/
CMPLTPAS
/
WORDSTAT.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1988-07-15
|
6KB
|
165 lines
{--------------------------------------------------------------}
{ WordStat }
{ }
{ Word Counter & Word Length Tabulator for TextFiles }
{ }
{ by Jeff Duntemann }
{ and Hugh Kenner }
{ Turbo Pascal V5.0 }
{ Last update 7/14/88 }
{ }
{ From: COMPLETE TURBO PASCAL 5.0 by Jeff Duntemann }
{ Scott, Foresman & Co., Inc. 1988 ISBN 0-673-38355-5 }
{--------------------------------------------------------------}
PROGRAM WordStat;
USES Printer;
CONST
PrintWidth = 68;
Tab = #9;
TYPE
Array40 = ARRAY[0..40] OF Integer;
String80 = String[80];
VAR
I,J : Integer;
Scale : Real;
Ch : Char;
Opened : Boolean;
TestFile : Text;
FName : String80;
Counters : Array40;
Line : String80;
AWord : String80;
WordLength : Integer;
LineCount : Integer;
WhiteSpace : SET OF Char;
GoodChars : SET OF Char;
PROCEDURE KillJunk(VAR AString : String80);
BEGIN
WhiteSpace := [#8,#9,#10,#12,#13,#32];
GoodChars := ['A'..'Z','a'..'z','0'..'9'];
REPEAT { Clean up leading end of word }
IF Length(AString) > 0 THEN
IF (AString[1] IN WhiteSpace) OR (NOT(AString[1] IN GoodChars))
THEN Delete(AString,1,1)
UNTIL ((NOT (AString[1] IN WhiteSpace)) AND (AString[1] IN GoodChars))
OR (Length(AString) <= 0);
REPEAT { Clean up trailing end of word }
IF Length(AString) > 0 THEN
IF (AString[Length(AString)] IN WhiteSpace)
OR (NOT(AString[Length(AString)] IN GoodChars))
THEN Delete(AString,Length(AString),1)
UNTIL ((NOT(AString[Length(AString)] IN WhiteSpace)
AND (AString[Length(AString)] IN GoodChars))
OR (Length(AString) <= 0))
END; { KillJunk }
PROCEDURE Opener( FileName : String80;
VAR TFile : Text;
VAR OpenFlag : Boolean);
VAR
I : Integer;
BEGIN
Assign(TFile,FileName); { Associate logical to physical }
{$I-} Reset(TFile); {$I+} { Open file for read }
I := IOResult; { I <> 0 = File Not Found }
IF I = 0 THEN OpenFlag := True ELSE OpenFlag := False;
END; { Opener }
FUNCTION Scaler(Counters : Array40) : Real;
VAR
I,MaxCount : Integer;
BEGIN
MaxCount := 0; { Set initial count to 0 }
FOR I := 1 TO 40 DO
IF Counters[I] > MaxCount THEN MaxCount := Counters[I];
IF MaxCount > PrintWidth THEN Scaler := PrintWidth / MaxCount
ELSE Scaler := 1.0; { Scale=1 if max < printer width}
END; { Scaler }
PROCEDURE Grapher(Counters : Array40; Scale : Real);
VAR
I,J : Integer;
BEGIN
FOR I := 1 TO 40 DO
BEGIN
Write(Lst,'[',I:3,']: '); { Show count }
FOR J:=1 TO Round(Counters[I] * Scale) DO Write(Lst,'*');
Writeln(Lst,'') { Add (CR) at end of *'s}
END
END;
BEGIN { WordStat Main }
FName := ParamStr(1); { We must pick up command tail first, }
KillJunk(FName); { before opening any files! }
FOR I:=0 TO 40 DO Counters[I]:=0; { Init Counters }
LineCount := 0;
Opener(FName,TestFile,Opened); { Attempt to open input file }
IF NOT Opened THEN { If we can't open it... }
BEGIN
Writeln('>>>Input file ',FName,' is missing or damaged.');
Writeln(' Please Check this file''s status and try again.');
END
ELSE { If you've got a file, run with it! }
BEGIN
WHILE NOT EOF(TestFile) DO { While there's stuff in the file }
BEGIN
Readln(TestFile,Line); { Read a Line }
LineCount := LineCount + 1; { Count the Line }
Write('.'); { Display a progress indicator }
FOR I := 1 TO Length(Line) DO
IF Line[I] = Tab THEN Line[I] := ' ';
WHILE Length(Line) > 0 DO { While there are words in the Line }
BEGIN
KillJunk(Line); { Remove any non-text characters }
IF POS(' ',Line) > 0 THEN
AWord := Copy(Line,1,POS(' ',Line)) ELSE AWord := Line;
KillJunk(AWord); { Clean up the individual word }
Counters[0] := Succ(Counters[0]); { Count the word }
WordLength := Length(AWord);
IF WordLength > 40 THEN WordLength := 40;
J := Counters[WordLength]; { Get counter for that Length }
J := Succ(J); { Increment it... }
Counters[WordLength] := J; { ...and put it back. }
Delete(Line,1,Length(AWord)); { Remove the word from the Line }
END
END;
Writeln;
Close(TestFile); { Close the input file }
{ The count itself is done. Now to display it: }
Scale := Scaler(Counters); { Scale the Counters }
Writeln(Lst,
'>>Text file ',FName,
' has ',Counters[0],
' words in ',LineCount,' Lines.');
Writeln(Lst,
' Word size histogram follows:');
Grapher(Counters,Scale); { Display Scaled histograms }
Writeln(Lst,Chr(12)); { Send a formfeed to printer }
END
END.